home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Low Level Languages / FORTRAN.500 / DISK6 / TEXT.FO$ / TEXT.bin
Encoding:
Text File  |  1991-03-11  |  1.6 KB  |  56 lines
  1. CC  TEXT.FOR - Illustrates text output functions including:
  2. CC             clearscreen      getbkcolor       gettextcolor
  3. CC             gettextposition outtext          setbkcolor
  4. CC             settextcolor    settextposition
  5. CC
  6.  
  7.       INCLUDE  'FGRAPH.FI'
  8.       INCLUDE  'FGRAPH.FD'
  9.  
  10.       INTEGER*2          dummy2, blink, fgd, oldfgd
  11.       INTEGER*4          dummy4, bgd, oldbgd
  12.       CHARACTER*4        str
  13.       RECORD / rccoord / curpos
  14.  
  15. C
  16. C     Save original foreground, background, and text position.
  17. C
  18.       oldfgd = gettextcolor()
  19.       oldbgd = getbkcolor()
  20.       CALL clearscreen( $GCLEARSCREEN )
  21. C
  22. C     First time no blink, second time blinking.
  23. C
  24.       DO blink = 0, 16, 16
  25. C
  26. C        Loop through 8 background colors.
  27. C
  28.          DO bgd = 0, 7
  29.             dummy4 = setbkcolor( bgd )
  30.             CALL settextposition( INT2( bgd + 1 ) + ((blink / 16) * 8),
  31.      +             1, curpos )
  32.             dummy2 = settextcolor( 15 )
  33.             WRITE (str, '(I4 )') bgd
  34.             CALL outtext( 'Back:' // str(3:4) // '  Fore:' )
  35. C
  36. C           Loop through 16 foreground colors.
  37. C
  38.             DO fgd = 0, 15
  39.                dummy2 = settextcolor( fgd + blink )
  40.                WRITE (str, '(I4)') fgd + blink
  41.                CALL outtext( str )
  42.             END DO
  43.          END DO
  44.       END DO
  45.  
  46.       WRITE (*, '(///// A \)') ' Press ENTER to exit . . . '
  47.       READ (*,*)
  48.  
  49. C
  50. C     Restore original foreground and background.
  51. C
  52.       dummy2 = settextcolor( oldfgd )
  53.       dummy4 = setbkcolor( oldbgd )
  54.       CALL clearscreen( $GCLEARSCREEN )
  55.       END
  56.